Vous travaillez chez La poule qui chante, une entreprise française agroalimentaire. Elle souhaite se développer à l’international. Votre objectif sera de proposer une première analyse des groupements de pays que l’on peut cibler pour exporter nos poulets. Pour cela, il faudra récupérer des données supplémentaires à celles fournies provenant de la FAO
Pour la partie analyse, il est demandé d’utiliser la classification ascendante hiérarchique, avec un dendrogramme comme visualisation, et également la méthode des k-means pour comparer les résultats des deux méthodes de clustering. Il est également possible de réaliser une ACP.
Dans ce deuxième notebook, nous allons traiter la partie analyse en utilisant différentes méthodes de clustering et de l’ACP sur les données travaillées dans le premier notebook.
Pour commencer, nous allons importer la table créée dans le premier notebook. Vérifions en même temps le type des données après l’importation.
BDD <- read.table("Données/BDDindnoscale.csv", header = T, row.names = 1, sep = ",", dec = ".")
kable(summary(BDD)) %>% scroll_box(width = "100%")
| Country.Code | Area | Production | Import.Quantity | Food | Population.growth..annual... | Population..total | Ease.of.doing.business.score..0...lowest.performance.to.100...best.performance. | GDP..constant.2015.US.. | Cost.to.import..border.compliance..US.. | Cost.to.import..documentary.compliance..US.. | Political.Stability.and.Absence.of.Violence.Terrorism..Estimate | comlang_off | dist | EEE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Length:168 | Length:168 | Min. :0.000000 | Min. :0.0000000 | Min. :0.0003763 | Min. :-1.6095 | Min. :5.283e+04 | Min. :32.69 | Min. : 278.3 | Min. : 0.0 | Min. : 0.00 | Min. :-2.72988 | Min. :0.0000 | Min. : 262.4 | Min. :0.0000 | |
| Class :character | Class :character | 1st Qu.:0.001743 | 1st Qu.:0.0004892 | 1st Qu.:0.0066568 | 1st Qu.: 0.4887 | 1st Qu.:2.762e+06 | 1st Qu.:54.59 | 1st Qu.: 1762.5 | 1st Qu.: 150.0 | 1st Qu.: 50.00 | 1st Qu.:-0.69276 | 1st Qu.:0.0000 | 1st Qu.: 2434.7 | 1st Qu.:0.0000 | |
| Mode :character | Mode :character | Median :0.011231 | Median :0.0034961 | Median :0.0181421 | Median : 1.2774 | Median :9.758e+06 | Median :63.01 | Median : 5482.2 | Median : 377.5 | Median : 98.75 | Median :-0.08188 | Median :0.0000 | Median : 5592.9 | Median :0.0000 | |
| NA | NA | Mean :0.016556 | Mean :0.0104331 | Mean :0.0210047 | Mean : 1.2837 | Mean :4.417e+07 | Mean :63.89 | Mean : 13192.0 | Mean : 449.7 | Mean : 159.69 | Mean :-0.12316 | Mean :0.1845 | Mean : 5942.9 | Mean :0.1607 | |
| NA | NA | 3rd Qu.:0.026228 | 3rd Qu.:0.0112236 | 3rd Qu.:0.0299057 | 3rd Qu.: 2.0932 | 3rd Qu.:3.209e+07 | 3rd Qu.:74.62 | 3rd Qu.: 16041.2 | 3rd Qu.: 634.0 | 3rd Qu.: 189.25 | 3rd Qu.: 0.59896 | 3rd Qu.:0.0000 | 3rd Qu.: 8666.1 | 3rd Qu.:0.0000 | |
| NA | NA | Max. :0.069619 | Max. :0.1029651 | Max. :0.0813795 | Max. : 3.9314 | Max. :1.408e+09 | Max. :86.76 | Max. :108570.0 | Max. :3039.0 | Max. :1025.00 | Max. : 1.63930 | Max. :1.0000 | Max. :19263.9 | Max. :1.0000 |
Nous allons maintenant modifier le nom des colonnes et le type
des colonnes “comlang” et “EEE”
colnames(BDD) <- c("Code Pays", "Pays", "Production", "Importation", "Nourriture", "Taux de croissance population", "Population", "Business score", "PIB US$2015", "Coût import conformité", "Coût import document", "Stabilité politique", "Langue commune", "Distance", "EEE")
BDDq <- BDD[,-c(1:2)]
BDDq[,c("Langue commune", "EEE")] <- apply(BDDq[,c("Langue commune", "EEE")], 2, function(x){as.character(x)})
Nous pouvons alors regarder la corrélation entre les variables.
pairs(BDDq[,-c(11,13)])
corrplot(cor(BDDq[,-c(11,13)], method = "spearman"))
Avant de réaliser notre classification, nous allons effectuer une analyse en composante principale ce qui rend la classification plus stable.
res.PCA <- PCA(BDDq[,-c(11,13)], ncp = 5, scale.unit = T, graph = F)
plot.PCA(res.PCA, choix = 'var', title = "Graphe des variables de l'ACP")
kable(round(res.PCA$eig,2)) %>% kable_paper()
| eigenvalue | percentage of variance | cumulative percentage of variance | |
|---|---|---|---|
| comp 1 | 3.89 | 35.38 | 35.38 |
| comp 2 | 1.70 | 15.43 | 50.82 |
| comp 3 | 1.24 | 11.28 | 62.10 |
| comp 4 | 0.96 | 8.77 | 70.86 |
| comp 5 | 0.93 | 8.41 | 79.28 |
| comp 6 | 0.81 | 7.39 | 86.67 |
| comp 7 | 0.42 | 3.79 | 90.46 |
| comp 8 | 0.41 | 3.77 | 94.23 |
| comp 9 | 0.27 | 2.47 | 96.69 |
| comp 10 | 0.25 | 2.31 | 99.00 |
| comp 11 | 0.11 | 1.00 | 100.00 |
On explique 50% d’inertie avec le premier plan et en conservant 5 dimensions nous expliquons près de 80% de la variance du jeu de données initial.
# Fonction pareto
pareto = function(x, bar.col="cyan", line.col="red", pch=16, h=80, h.lty=3,main="Eboulis des valeurs propres",xlab="Dimensions",ylab="Variance expliquée (%)", names.arg=c(1:length(x)), ylab2="Cumul",mar=c(5,4,3,4)) {
if (length(names.arg)>0) {names.arg=names.arg[order(x, decreasing = TRUE)]}
x = sort(x,decreasing=T); x = x*100/sum(x);
cumul = (cumsum(x)/sum(x))*100
simulation = barplot(x,col=bar.col, plot = F)
par(mar=mar)
barplot(x,col=bar.col,axes=F,ylim=c(0,100),main=main,xlab=xlab,ylab="",names.arg=names.arg)
#par(new=TRUE)
points(simulation,cumul,pch=pch,col=line.col,xlab="",ylab="",type="o")
abline(h=h,lty=h.lty) ; box()
axis(2) ; axis(4,c(0,20,40,60,80,100),col.axis=line.col,col=line.col)
mtext(ylab,side=2,line=2,cex=1.2) ; mtext(ylab2,side=4,col="red",line=2,cex=1.2)
result = c(x , cumul) ; result = matrix(result,nc=length(x), byrow=T)
if (length(names.arg)>0) {colnames(result) = names.arg }
rownames(result) = c("frequency","cumul")
#return(result)
}
pareto(res.PCA$eig[,2], h=80)
Nous allons maintenant nous intéresser à la description des axes, pour cela nous allons regarder en premier lieu la qualité de représentation des variables.
kable(round(res.PCA$var$cos2, 2)) %>% column_spec(1, bold = T)
| Dim.1 | Dim.2 | Dim.3 | Dim.4 | Dim.5 | |
|---|---|---|---|---|---|
| Production | 0.35 | 0.00 | 0.37 | 0.21 | 0.00 |
| Importation | 0.09 | 0.51 | 0.16 | 0.06 | 0.08 |
| Nourriture | 0.36 | 0.38 | 0.08 | 0.03 | 0.05 |
| Taux de croissance population | 0.50 | 0.01 | 0.02 | 0.00 | 0.06 |
| Population | 0.00 | 0.09 | 0.21 | 0.43 | 0.22 |
| Business score | 0.67 | 0.07 | 0.00 | 0.01 | 0.00 |
| PIB US$2015 | 0.45 | 0.00 | 0.07 | 0.00 | 0.02 |
| Coût import conformité | 0.37 | 0.30 | 0.02 | 0.01 | 0.04 |
| Coût import document | 0.53 | 0.01 | 0.00 | 0.03 | 0.13 |
| Stabilité politique | 0.52 | 0.08 | 0.05 | 0.05 | 0.09 |
| Distance | 0.05 | 0.25 | 0.27 | 0.10 | 0.23 |
On peut voir que le Business score est la variable la mieux
représentée sur l’axe 1 et l’importation sur l’axe 2. Les scores ne sont
cependant pas très élevés. Il sera compliqué d’interpréter le cercle des
variables.
corrplot(res.PCA$var$cor)
Comme nous pouvions nous y attendre avec le cercle des
variables, l’axe 1 est expliqué par le business score, le PIB, la
stabilité politique qui augmentent de gauche à droite et il est
anti-corrélé avec le coût d’importation et le taux de croissance de la
population. L’axe 2 lui est plutôt bien corrélé avec les variables
d’importation, de nourriture et de Distance.
Nous pouvons alors regarder si des individus contribuent
particulièrement à nos axes.
kable(head(sort(res.PCA$ind$contrib[,1], decreasing = T), 5)) %>% column_spec(1, bold = T) #5 individus les plus contributeurs de l'axe 1
| x | |
|---|---|
| Congo, Rép. dém. du | 5.800930 |
| Afghanistan | 3.164081 |
| Cameroun | 3.013314 |
| Burundi | 2.946778 |
| Tchad | 2.298052 |
kable(head(sort(res.PCA$ind$contrib[,2], decreasing = T), 5)) %>% column_spec(1, bold = T) #5 individus les plus contributeurs de l'axe 2
| x | |
|---|---|
| Samoa | 12.322408 |
| Bahamas | 6.048188 |
| Saint-Vincent-et-les Grenadines | 6.037743 |
| Grenade | 4.583143 |
| Hong-Kong | 4.498022 |
On peut voir que les Samoa ont un impact fort sur l’axe 2. Il
est donc intéressant de voir ce qu’il se produit si nous n’utilisons pas
cet individu. En faisant des test via la librairie “Factoshiny”, on voit
que cela ne change pas suffisamment les résultats de l’ACP pour le
présenter dans notre analyse.
Regardons si les individus sont bien représentés sur notre plan.
fviz_pca_ind(res.PCA, col.ind="cos2", geom = "point") +
scale_color_gradient2(low="blue", mid="white",
high="red", midpoint=0.6)
On peut voir que les individus au centre sont mal représentés
(cos²<0.25) sur ce plan. Heureusement, nous conservons 5 dimensions
pour réaliser le clustering.
Nous allons maintenant effectuer une classification ascendante
hiérarchique en utilisant les coordonnées de l’ACP.
res.HCPC <- HCPC(res.PCA, nb.clust=-1, consol=F, graph=FALSE)
#nb.clust = -1 pour que l'algorithme choisisse automatiquement le nombre de clusters
#consol: k-means consolidation
plot(res.HCPC, choice = "bar")
L’algorithme a sélectionné pour nous 5 clusters. Ce nombre de clusters est suffisant pour notre analyse. Comme nous le verrons par la suite, les clusters que nous allons sélectionner n’auraient pas été modifiés en ajoutant d’autres clusters. Regardons un instant l’arbre hiérarchique ainsi construit.
plot.HCPC(res.HCPC,choice='tree',title='Arbre hiérarchique')
Nous pouvons regarder notre clustering sur le plan factoriel (1,2) ce qui nous donnera une meilleur vue des clusters même si ceux-ci ne seront toujours pas très lisibles.
plot.HCPC(res.HCPC, choice = 'map', draw.tree = FALSE, centers.plot= TRUE, title = 'Plan factoriel', axes = c(1,2))
Etant donné que nous travaillions avec des pays, nous pouvons représenter nos clusters sur une mappemonde ce qui sera bien plus facile à “lire”.
BDD$groupe_cah <- as.numeric(res.HCPC$data.clust$clust)
BDDq$groupe_cah <- BDD$groupe_cah
#On créé une palette de couleurs pour la mappemonde
foo <- brewer.pal(n = 5,name = "Set2")
names(foo) = levels(1:5)
Z_Breaks = function(n){
CUTS = seq(0,1,length.out=n+1)
rep(CUTS,ifelse(CUTS %in% 0:1,1,2))
}
colorScale <- data.frame(z=Z_Breaks(5), col=rep(foo,each=2), stringsAsFactors=FALSE)
fig <- plot_ly(BDD, type='choropleth', locations = BDD$`Code Pays`, z = BDD$groupe_cah, colorscale=colorScale, colorbar=list(tickvals=seq(1,5), ticktext=names(foo)), hoverinfo = "none", width = "100%") %>% layout(title = '<b>Clusters Classification ascendante hiérarchique</b>')
fig
Nous pouvons alors voir que le cluster 1 est constitué en majeur
partie de pays Africain, le cluster 2 est composé de l’Inde et
de la Chine, le cluster 3 des pays d’Amérique du sud ainsi que
de l’Australie, de la Russie etc.
Le cluster 4 n’est pas visible sur la mappemonde, il est composé d’îles,
nous regarderons en détail les pays qui le compose. Enfin, le cluster 5
est constitué de pays européen, du Canada et des Etats
Unis.
Regardons en détail le nombre de pays dans chaque cluster.
freq(res.HCPC$data.clust$clust)
Regardons la liste des pays présents dans le cluster 4.
kable(BDDq[BDDq$groupe_cah==4,]) %>% kable_paper() %>% column_spec(1, bold = T) %>% scroll_box(width = "100%", height = "100%")
| Production | Importation | Nourriture | Taux de croissance population | Population | Business score | PIB US$2015 | Coût import conformité | Coût import document | Stabilité politique | Langue commune | Distance | EEE | groupe_cah | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Emirats arabes unis | 0.0046057 | 0.0702112 | 0.0340821 | 1.4386771 | 9770526 | 80.75261 | 40438.339 | 553.3333 | 283.3333 | 0.6856085 | 0 | 5249.535 | 0 | 4 |
| Antigua-et-Barbuda | 0.0000000 | 0.0720795 | 0.0617824 | 0.8614458 | 97115 | 60.28342 | 16786.447 | 546.3889 | 100.0000 | 0.9535552 | 0 | 6708.770 | 0 | 4 |
| Bahamas | 0.0154049 | 0.0641872 | 0.0539172 | 0.9936595 | 389486 | 59.87155 | 32136.762 | 1385.0000 | 550.0000 | 0.8162377 | 0 | 7209.450 | 0 | 4 |
| Dominique | 0.0000000 | 0.0557041 | 0.0417781 | 0.2537754 | 71808 | 60.54797 | 7914.136 | 905.5556 | 50.0000 | 1.0674570 | 1 | 6826.396 | 0 | 4 |
| Grenade | 0.0000000 | 0.0624989 | 0.0446421 | 0.4949641 | 112002 | 53.44488 | 10133.132 | 1256.0000 | 50.0000 | 0.9535552 | 0 | 7120.287 | 0 | 4 |
| Hong-Kong | 0.0025308 | 0.1029651 | 0.0531476 | 0.7540949 | 7507400 | 85.31540 | 44189.693 | 265.6250 | 56.8000 | -0.2221780 | 0 | 9639.476 | 0 | 4 |
| Saint-Christophe-et-Niévès | 0.0000000 | 0.0757088 | 0.0567816 | 0.7523404 | 52834 | 54.63689 | 21516.799 | 310.7143 | 90.0000 | 0.7239246 | 0 | 6760.687 | 0 | 4 |
| Saint-Vincent-et-les Grenadines | 0.0000000 | 0.0723373 | 0.0813795 | 0.3469159 | 110593 | 57.08690 | 7219.892 | 540.0000 | 90.0000 | 0.9535552 | 0 | 6989.701 | 0 | 4 |
| Samoa | 0.0000000 | 0.1014749 | 0.0659587 | 0.4908191 | 197093 | 62.07404 | 4502.926 | 900.0000 | 230.0000 | 1.1577890 | 0 | 16011.920 | 0 | 4 |
Nous pouvons regarder quelles variables caractérisent le plus
la partition.
kable(res.HCPC$desc.var$quanti.var) %>% kable_paper() %>% column_spec(1, bold = T)
| Eta2 | P-value | |
|---|---|---|
| Population | 0.9021800 | 0 |
| Importation | 0.7711080 | 0 |
| Nourriture | 0.5960269 | 0 |
| Taux.de.croissance.population | 0.5510743 | 0 |
| Business.score | 0.4974972 | 0 |
| Production | 0.4670542 | 0 |
| PIB.US$2015 | 0.4546937 | 0 |
| Distance | 0.3510928 | 0 |
| Coût.import.document | 0.3242564 | 0 |
| Stabilité.politique | 0.3140982 | 0 |
| Coût.import.conformité | 0.3078322 | 0 |
La variable qui caractérise le mieux la partition est la variable population. Pour savoir comment catégoriser les clusters, nous allons récupérer les valeurs test des variables pour chaque cluster. Cela nous permettra de faire une heatmap afin de faciliter la lecture de ces résultats.
BDDq$groupe_cah <- as.character(BDDq$groupe_cah)
clustvtest <- matrix(nrow = 5, ncol = 11)
colnames(clustvtest) <- c("Coût.import.document", "Coût.import.conformité", "Taux.de.croissance.population", "Population", "Distance", "Importation", "PIB.US$2015", "Production", "Nourriture", "Business.score", "Stabilité.politique")
for (x in 1:5) {
valtest <- as.array(catdes(BDDq[,-c(11,13)], num.var= 12, proba = 1)$quanti[x])
#num.var = position de la variable, proba = 1 pour récupérer toutes les vars sinon suppression de celles qui ne respectent pas la condition
for (y in colnames(clustvtest)) {
clustvtest[x, y] <- valtest[[1]][y, "v.test"]
}
}
rownames(clustvtest) <- as.character(1:5)
pheatmap(clustvtest,
display_numbers = matrix(ifelse(clustvtest > 2 | clustvtest < -2, format(clustvtest, scientific = FALSE, digits = 1), ""), nrow(clustvtest)),
legend = TRUE,
cluster_rows = FALSE,
cluster_cols = FALSE)
On remarque 2 clusters qui peuvent nous intérésser:
- le cluster 4, qui a une importation de viande de volaille bien plus
importante que la moyenne mondiale, une production inférieure et une
stabilité politique correcte. Nous appellerons ce cluster le cluster
“Importateur”.
- Le cluster 5, qui n’a pas de coût d’import important, est proche de
notre pays, un business score élevé et un PIB élevé. Par contre celui-ci
produit plus de viande de volaille que la moyenne mondiale. Nous
appellerons ce cluster “Européen”.
Comme nous l’avions expliqué au début de la classification ascendante
hiérarchique, choisir 6 ou 7 clusters n’auraient pas impacté notre choix
étant donné que les clusters retenus n’auraient pas été
redécoupés.
Nous pouvons maintenant afficher le rapport entre les clusters et les
axes.
res.HCPC$desc.axes
Link between the cluster variable and the quantitative variables
================================================================
Eta2 P-value
Dim.1 0.7757964 7.675090e-52
Dim.2 0.5983605 2.568070e-31
Dim.4 0.5941753 5.936524e-31
Dim.3 0.4168318 2.857049e-18
Dim.5 0.3111958 1.681867e-12
Description of each cluster by quantitative variables
=====================================================
$`1`
v.test Mean in category Overall mean sd in category Overall sd p.value
Dim.3 -2.714424 -0.3098886 3.311979e-16 0.3952128 1.1139333 6.639111e-03
Dim.5 -2.742463 -0.2704119 -3.148471e-16 1.0546112 0.9620913 6.098028e-03
Dim.1 -10.324171 -2.0874448 4.829140e-16 1.1845464 1.9728364 5.479005e-25
$`2`
v.test Mean in category Overall mean sd in category Overall sd p.value
Dim.4 8.995304 6.227979 4.069166e-16 0.02668669 0.9820882 2.355804e-19
Dim.5 5.469682 3.709874 -3.148471e-16 0.06336982 0.9620913 4.508437e-08
Dim.3 4.773561 3.748716 3.311979e-16 0.34492131 1.1139333 1.809965e-06
Dim.2 -3.216892 -2.954886 -2.463824e-16 0.21495261 1.3029372 1.295875e-03
$`3`
v.test Mean in category Overall mean sd in category Overall sd p.value
Dim.3 6.007034 0.6857850 3.311979e-16 1.0823143 1.1139333 1.889480e-09
Dim.1 2.396753 0.4845997 4.829140e-16 0.8590835 1.9728364 1.654105e-02
Dim.4 -2.303286 -0.2318287 4.069166e-16 0.6765416 0.9820882 2.126274e-02
$`4`
v.test Mean in category Overall mean sd in category Overall sd p.value
Dim.2 8.769299 3.716271 -2.463824e-16 0.9581325 1.3029372 1.797826e-18
Dim.5 3.679695 1.151456 -3.148471e-16 0.4626395 0.9620913 2.335131e-04
Dim.4 3.257329 1.040474 4.069166e-16 0.5755189 0.9820882 1.124659e-03
Dim.1 2.055822 1.319155 4.829140e-16 0.7107922 1.9728364 3.979965e-02
Dim.3 -3.376663 -1.223393 3.311979e-16 0.4816681 1.1139333 7.337094e-04
$`5`
v.test Mean in category Overall mean sd in category Overall sd p.value
Dim.1 8.259765 2.4580593 4.829140e-16 0.5527001 1.9728364 1.459592e-16
Dim.4 -2.587085 -0.3832611 4.069166e-16 0.5248940 0.9820882 9.679182e-03
Dim.3 -3.301504 -0.5547593 3.311979e-16 1.0455238 1.1139333 9.616783e-04
Dim.2 -4.337363 -0.8524773 -2.463824e-16 0.4137585 1.3029372 1.442021e-05
Enfin nous pouvons afficher les parangons (individu le plus proche du centroïde) et les individus les plus distants des autres clusters.
res.HCPC$desc.ind
$para
Cluster: 1
Haïti Guinée Sierra Leone Guinée-Bissau Togo
0.3466497 0.5013131 0.5776802 0.6101210 0.6389535
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 2
Chine Inde
0.7380374 0.7380374
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 3
Costa Rica Dominicaine (la République) Salvador Mexique Colombie
0.7203778 0.7220641 0.7803338 0.9128348 0.9625596
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 4
Antigua-et-Barbuda Saint-Christophe-et-Niévès Saint-Vincent-et-les Grenadines Grenade Dominique
0.3187694 0.5749673 0.7744774 0.9617319 1.1500458
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 5
Slovénie Portugal Lituanie Roumanie Belgique et Luxembourg
0.3528271 0.5306957 0.5722881 0.6018803 0.6058568
$dist
Cluster: 1
Congo, Rép. dém. du Afghanistan Cameroun Burundi Syrie
7.369032 5.541593 5.363700 5.250516 4.964134
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 2
Chine Inde
8.823583 8.717958
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 3
Fidji Barbade Nouvelle-Zélande Brésil Argentine
4.503289 4.393273 4.392379 4.261806 4.218437
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 4
Samoa Hong-Kong Bahamas Saint-Vincent-et-les Grenadines Antigua-et-Barbuda
6.388137 5.215557 4.860089 4.790974 4.419489
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Cluster: 5
Luxembourg Etats-Unis d'Amérique Suisse Danemark Norvège
4.688829 4.148660 4.038367 3.737562 3.656819
Nous pouvons alors regarder l’effet d’une consolidation via K-means sur notre CAH et conserver le clustering le plus intéressant pour notre analyse.
res.HCPC2 <- HCPC(res.PCA, nb.clust=-1, consol=T, graph=FALSE)
BDD$groupe_cah2 <- as.numeric(res.HCPC2$data.clust$clust)
BDDq$groupe_cah2 <- BDD$groupe_cah2
fig <- plot_ly(BDD, type='choropleth', locations=BDD$`Code Pays`, z=BDD$groupe_cah2, colorscale=colorScale, colorbar=list(tickvals=seq(1,5), ticktext=names(foo)), hoverinfo = "none", width = "100%") %>% layout(title = '<b>Cluster CAH avec consolidation</b>')
fig
Nous pouvons voir que notre cluster “Européen” a été grandement augmenté, or ce qui nous intéresse dans ce cluster est la faible distance des pays avec la France, l’appartenance à l’espace économique européen qui facilitera les échanges donc nous allons conserver le clustering CAH sans consolidation.
BDDq$groupe_cah2 <- NULL
BDD$groupe_cah2 <- NULL
Nous pouvons maintenant regarder les clusters obtenus si nous utilisons uniquement l’algorithme K-Means.
Nous allons commencer par regarder le nombre de clusters le plus pertinent pour l’algorithme des K-Means
#évaluer la proportion d'inertie expliquée
inertie.expl <- rep(0,times=10)
for (k in 2:10){
clus <- kmeans(res.PCA$ind$coord,centers=k,nstart=50,iter.max=20)
inertie.expl[k] <- clus$betweenss/clus$totss
}
#graphique
plot(1:10,inertie.expl,type="b",xlab="Nb. de groupes",ylab="% inertie expliquée")
#(2) indice de Calinski Harabasz - utilisation du package fpc
#évaluation des solutions
sol.kmeans <- kmeansruns(res.PCA$ind$coord,krange=2:10,criterion="ch")
#graphique
plot(1:10,sol.kmeans$crit,type="b",xlab="Nb. de groupes",ylab="Silhouette")
Bien que les indicateurs nous indiquent d’utiliser 6 clusters, afin de comparer les méthodes de clustering entre elles, nous allons utiliser 5 clusters.
groupes.kmeans <- kmeans(res.PCA$ind$coord, centers = 5, nstart = 50, iter.max = 20)
print(groupes.kmeans[c("size","centers")])
$size
[1] 49 2 13 27 77
$centers
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
1 1.92207385 -0.8651973 -0.5771090 -0.22229444 0.1933204
2 -0.06545822 -2.9548860 3.7487155 6.22797902 3.7098741
3 1.11645605 3.1172516 -0.9532858 0.75881145 0.9101133
4 1.03740088 0.7003659 1.7149825 -0.65782783 -0.2733614
5 -1.77369421 -0.1445417 -0.1705312 0.08225029 -0.2771839
BDD$groupe_kmeans <- groupes.kmeans$cluster
BDDq$groupe_kmeans <- BDD$groupe_kmeans
fig <- plot_ly(BDD, type='choropleth', locations=BDD$`Code Pays`, z=BDD$groupe_kmeans, colorscale=colorScale, colorbar=list(tickvals=seq(1,5), ticktext=names(foo)), hoverinfo = "none", width = "100%") %>% layout(title = '<b>Cluster K-Means</b>')
fig
Nous pouvons comparer les clusters entre K-Means et CAH mais nous voyons déjà que nous retiendrons la classification via CAH car celle-ci nous apporte une nouvelle fois un cluster européen plus petit.
#Correspondances CAH Kmeans
print(table(BDD$groupe_cah,groupes.kmeans$cluster))
1 2 3 4 5
1 0 0 0 0 61
2 0 2 0 0 0
3 16 0 4 25 16
4 0 0 9 0 0
5 33 0 0 2 0
Dans cette table, nous pouvons voir que les 2 clusters que nous
avions sélectionnés avec CAH (4 et 5) sont plus petits avec CAH:
- Pour le cluster 4: 9 pays avec CAH, 13 avec K-Means.
- Pour le cluster 5: 35 pays avec CAH, 49 avec K-Means.
BDDq$groupe_kmeans <- as.character(BDDq$groupe_kmeans)
clustvtest <- matrix(nrow = 5, ncol = 11)
colnames(clustvtest) <- c("Coût.import.document", "Coût.import.conformité", "Taux.de.croissance.population", "Population", "Distance", "Importation", "PIB.US$2015", "Production", "Nourriture", "Business.score", "Stabilité.politique")
for (x in 1:5) {
valtest <- as.array(catdes(BDDq[, -c(11, 13:14)], num.var= 12, proba = 1)$quanti[x])
#num.var = position de la variable, proba = 1 pour récupérer toutes les vars sinon suppression de celles qui ne respectent pas la proba
for (y in colnames(clustvtest)) {
clustvtest[x, y] <- valtest[[1]][y, "v.test"]
}
}
rownames(clustvtest) <- as.character(1:5)
pheatmap(clustvtest,
display_numbers = matrix(ifelse(clustvtest > 2 | clustvtest < -2, format(clustvtest, scientific = FALSE, digits = 1), ""), nrow(clustvtest)),
legend = TRUE,
cluster_rows = FALSE,
cluster_cols = FALSE)
Nous retrouvons les 2 clusters les plus intéressants pour nous, à savoir le cluster dit “Européen” qui se caractérise par des coûts d’import faible et une distance faible et un cluster dit “Importateur” où l’importation par habitant est la plus élevée.
Comme expliqué plus haut, nous allons conserver la classification via
CAH et mener notre analyse sur 2 clusters:
- Un cluster “Européen” où nos exportations seront peu
coûteuses car les pays sont proches et, certains faisant partie de
l’espace économique européen, il n’y a pas de droit de douane.
L’internationalisation sera alors plus facile car moins de documents
juridiques. De plus ces pays ayant un PIB par habitant plus élevé que
les autres, nous pourrons vendre des produits plus chères.
- Un cluster “Importateur” où nous allons jouer sur la quantité
vendue car ces pays sont de plus grands consommateurs de viande de
volaille. Le coût à l’exportation est cependant plus élevé et la
distance avec ces pays est grande ce qui peut donner une mauvaise image
écologique à l’entreprise.
Commençons par regarder le cluster Européen.
Nous allons de nouveau effectuer une ACP afin de faire une sélection plus fine des candidats de ce cluster.
Choix1 <- BDDq[BDDq$groupe_cah==5, -c(14:15)]
res.pca=PCA(Choix1, scale.unit=T, graph = F, quali.sup = c(11,13))
plot.PCA(res.pca,choix='var',title="Graphe des variables de l'ACP")
On peut voir que l’axe 1 est corrélé avec les coûts d’importation, la quantité de viande de volaille consommée, la distance et est anti-corrélé avec l’importation. L’axe 2 lui est corrélé avec la stabilité politique, le PIB, le business score. Nous choisirons alors les individus qui sont dans la partie supérieur gauche du cercle.
plot.PCA(res.pca,invisible=c('quali','ind.sup'), habillage = c(11,13), title="Graphe des individus de l'ACP",label =c('ind'))
kable(Choix1[order(Choix1$Importation, decreasing = T),]) %>% kable_paper() %>% column_spec(1, bold = T) %>% scroll_box(width = "100%", height = "400px", fixed_thead = T)
| Production | Importation | Nourriture | Taux de croissance population | Population | Business score | PIB US$2015 | Coût import conformité | Coût import document | Stabilité politique | Langue commune | Distance | EEE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Pays-Bas | 0.0597295 | 0.0347077 | 0.0052465 | 0.6550716 | 17344874 | 76.10376 | 48443.732 | 0.00000 | 0.00000 | 0.8475496 | 0 | 427.9169 | 1 |
| Belgique et Luxembourg | 0.0389939 | 0.0278528 | 0.0126208 | 0.5404613 | 11488980 | 74.98904 | 43071.107 | 0.00000 | 0.00000 | 0.4737775 | 1 | 262.3845 | 1 |
| Lettonie | 0.0182880 | 0.0250807 | 0.0209006 | -0.6952391 | 1913822 | 80.28054 | 16056.035 | 0.00000 | 0.00000 | 0.4434652 | 0 | 1704.5980 | 1 |
| Danemark | 0.0271738 | 0.0244220 | 0.0251100 | 0.3581309 | 5814422 | 85.28856 | 57553.131 | 0.00000 | 0.00000 | 0.9956252 | 0 | 1027.6090 | 1 |
| Luxembourg | 0.0000000 | 0.0193548 | 0.0193548 | 1.9628449 | 620001 | 69.60310 | 108570.028 | 0.00000 | 0.00000 | 1.3491910 | 1 | 289.1023 | 1 |
| Irlande | 0.0312098 | 0.0192528 | 0.0263460 | 1.3676270 | 4934340 | 79.57614 | 75143.018 | 253.00000 | 75.00000 | 0.9663891 | 0 | 778.2031 | 1 |
| Slovaquie | 0.0130176 | 0.0190681 | 0.0148511 | 0.1353281 | 5454147 | 75.58542 | 18167.484 | 0.00000 | 0.00000 | 0.6671577 | 0 | 1094.6100 | 1 |
| Estonie | 0.0150732 | 0.0188415 | 0.0218562 | 0.3683137 | 1326855 | 80.61685 | 20408.436 | 0.00000 | 0.00000 | 0.6332563 | 0 | 1859.0910 | 1 |
| Lituanie | 0.0357892 | 0.0175367 | 0.0297051 | -0.2647044 | 2794137 | 81.61948 | 17241.255 | 0.00000 | 0.00000 | 0.7798127 | 0 | 1700.2960 | 1 |
| Bulgarie | 0.0156255 | 0.0159122 | 0.0227932 | -0.7039056 | 6975761 | 71.97405 | 8234.781 | 0.00000 | 0.00000 | 0.5788610 | 0 | 1760.7070 | 1 |
| Autriche | 0.0148650 | 0.0127253 | 0.0179056 | 0.4446736 | 8879920 | 78.74549 | 46669.751 | 0.00000 | 0.00000 | 0.9167479 | 0 | 1035.1440 | 1 |
| Royaume-Uni | 0.0284576 | 0.0119396 | 0.0334848 | 0.5641311 | 66836327 | 83.54968 | 47750.880 | 0.00000 | 0.00000 | 0.5397319 | 0 | 342.9475 | 0 |
| Slovénie | 0.0335187 | 0.0110133 | 0.0239419 | 0.6963040 | 2088385 | 76.51751 | 24071.282 | 0.00000 | 0.00000 | 0.8074292 | 0 | 965.7366 | 1 |
| Tchèque (la République) | 0.0159297 | 0.0108697 | 0.0228638 | 0.3937889 | 10671870 | 76.34054 | 20202.152 | 0.00000 | 0.00000 | 0.9438875 | 0 | 884.6105 | 1 |
| Allemagne | 0.0185816 | 0.0100008 | 0.0181002 | 0.2255199 | 83092962 | 79.71004 | 43329.051 | 0.00000 | 0.00000 | 0.5743086 | 0 | 439.8984 | 1 |
| Portugal | 0.0340260 | 0.0087495 | 0.0324705 | 0.0237335 | 10286263 | 76.46616 | 21617.412 | 0.00000 | 0.00000 | 1.0662310 | 0 | 1452.8600 | 1 |
| Moldavie | 0.0161352 | 0.0086305 | 0.0251410 | -1.6095076 | 2664974 | 74.39091 | 3435.477 | 82.77778 | 41.11111 | -0.3932399 | 0 | 1976.8540 | 0 |
| Suède | 0.0153713 | 0.0081721 | 0.0167333 | 1.0137223 | 10278887 | 81.99155 | 53490.352 | 0.00000 | 0.00000 | 1.0394730 | 0 | 1545.7970 | 1 |
| Hongrie | 0.0544460 | 0.0077780 | 0.0264043 | -0.0452557 | 9771141 | 73.41584 | 15041.099 | 0.00000 | 0.00000 | 0.7721581 | 0 | 1247.2400 | 1 |
| Croatie | 0.0132833 | 0.0073796 | 0.0167271 | -0.5541467 | 4065253 | 73.62096 | 14068.045 | 0.00000 | 0.00000 | 0.6946999 | 0 | 1081.7620 | 1 |
| Grèce | 0.0214521 | 0.0073683 | 0.0249963 | -0.1053394 | 10721582 | 68.42391 | 19003.829 | 0.00000 | 0.00000 | 0.1817382 | 0 | 2098.7260 | 0 |
| Roumanie | 0.0261723 | 0.0067108 | 0.0238493 | -0.5268148 | 19371648 | 73.33320 | 11221.708 | 0.00000 | 0.00000 | 0.5617022 | 0 | 1875.0180 | 1 |
| Islande | 0.0277344 | 0.0055469 | 0.0305078 | 2.1989323 | 360563 | 78.96154 | 57818.859 | 365.00000 | 0.00000 | 1.6393010 | 0 | 2234.7230 | 1 |
| Suisse | 0.0115448 | 0.0052476 | 0.0173755 | 0.7133137 | 8575280 | 76.61864 | 88413.192 | 115.00000 | 27.00000 | 1.3249530 | 1 | 436.0778 | 0 |
| Canada | 0.0399987 | 0.0047605 | 0.0408763 | 1.4361368 | 37601230 | 79.64043 | 45109.244 | 171.87500 | 162.50000 | 1.0167680 | 1 | 6004.6450 | 0 |
| Espagne | 0.0346029 | 0.0039886 | 0.0330541 | 0.7177156 | 47134837 | 77.93588 | 28101.527 | 0.00000 | 0.00000 | 0.3106858 | 0 | 1054.6560 | 1 |
| Bosnie-Herzégovine | 0.0212057 | 0.0033323 | 0.0169646 | -0.6922670 | 3300998 | 65.44253 | 5578.266 | 108.50000 | 26.50000 | -0.4187543 | 0 | 1352.4630 | 0 |
| Finlande | 0.0251738 | 0.0030788 | 0.0199217 | 0.1101917 | 5521606 | 80.17834 | 46135.078 | 0.00000 | 0.00000 | 0.8516567 | 0 | 1911.1380 | 1 |
| Serbie | 0.0149743 | 0.0024477 | 0.0161262 | -0.5366100 | 6945235 | 75.65345 | 6567.910 | 52.00000 | 35.00000 | -0.0659501 | 0 | 1449.7180 | 0 |
| Pologne | 0.0673770 | 0.0023179 | 0.0284469 | -0.0244271 | 37965475 | 76.38122 | 15016.673 | 0.00000 | 0.00000 | 0.5636535 | 0 | 1368.1780 | 1 |
| Italie | 0.0227360 | 0.0015738 | 0.0190192 | -1.1530284 | 59729081 | 72.85055 | 32090.995 | 0.00000 | 0.00000 | 0.4043851 | 0 | 1109.9010 | 1 |
| Biélorussie | 0.0495766 | 0.0010616 | 0.0286632 | -0.2017866 | 9419758 | 74.29113 | 6264.861 | 0.00000 | 0.00000 | 0.3323891 | 0 | 1823.7090 | 0 |
| Norvège | 0.0200079 | 0.0005610 | 0.0201949 | 0.6750614 | 5347896 | 82.62729 | 76005.225 | 125.00000 | 0.00000 | 1.1705650 | 0 | 1342.8900 | 1 |
| Etats-Unis d'Amérique | 0.0696190 | 0.0003746 | 0.0587275 | 0.4553813 | 328329953 | 83.99668 | 60836.771 | 175.00000 | 100.00000 | 0.1349753 | 0 | 5838.1570 | 0 |
| Israël | 0.0681467 | 0.0000000 | 0.0674840 | 1.9089826 | 9054000 | 76.67572 | 38995.230 | 306.66670 | 70.00000 | -0.7933716 | 0 | 3281.8990 | 0 |
liste_pays <- rownames(res.pca$ind$coord[res.pca$ind$coord[,1]<0 & res.pca$ind$coord[,2]>0,])
kable(BDDq[rownames(BDDq) %in% liste_pays, c("Importation", "Business score", "PIB US$2015", "Stabilité politique", "Population")]) %>%
kable_paper() %>% column_spec(1, bold = T)
| Importation | Business score | PIB US$2015 | Stabilité politique | Population | |
|---|---|---|---|---|---|
| Autriche | 0.0127253 | 78.74549 | 46669.75 | 0.9167479 | 8879920 |
| Belgique et Luxembourg | 0.0278528 | 74.98904 | 43071.11 | 0.4737775 | 11488980 |
| Suisse | 0.0052476 | 76.61864 | 88413.19 | 1.3249530 | 8575280 |
| Tchèque (la République) | 0.0108697 | 76.34054 | 20202.15 | 0.9438875 | 10671870 |
| Allemagne | 0.0100008 | 79.71004 | 43329.05 | 0.5743086 | 83092962 |
| Danemark | 0.0244220 | 85.28856 | 57553.13 | 0.9956252 | 5814422 |
| Estonie | 0.0188415 | 80.61685 | 20408.44 | 0.6332563 | 1326855 |
| Finlande | 0.0030788 | 80.17834 | 46135.08 | 0.8516567 | 5521606 |
| Luxembourg | 0.0193548 | 69.60310 | 108570.03 | 1.3491910 | 620001 |
| Pays-Bas | 0.0347077 | 76.10376 | 48443.73 | 0.8475496 | 17344874 |
| Slovénie | 0.0110133 | 76.51751 | 24071.28 | 0.8074292 | 2088385 |
| Suède | 0.0081721 | 81.99155 | 53490.35 | 1.0394730 | 10278887 |
La représentation des pays est en accord avec les données
brutes.
Si nous devons faire un choix plus précis dans le cluster
“Européen” pour savoir quels sont nos meilleurs candidats, nous
pourrons sélectionner le Luxembourg ou la Belgique qui ont l’avantage de
parler français et de faire partie de l’espace économique européen. Si
nous souhaitons plus de candidats, nous pouvons ajouter les
Pays-Bas, le Danemark, la Suède,
l’Autriche.
Regardons maintenant les meilleurs candidats du cluster “Importateur”.
Choix2 <- BDDq[BDDq$groupe_cah==4, -c(14:15)]
res.pca=PCA(Choix2, scale.unit=T, graph = F, quali.sup = c(11,13))
plot.PCA(res.pca,choix='var',title="Graphe des variables de l'ACP")
L’axe 1 est corrélé avec le PIB, la population, le business score et anti-corrélé avec la stabilité politique. L’axe 2 lui est corrélé aux coûts d’importation et anti-corrélé à l’importation. Il faut donc faire un arbitrage entre des pays plutôt riches avec un business score élevé mais moyennement stable politiquement et le contraire. Nous ferons le choix ici de conserver les pays riches et importateurs.
plot.PCA(res.pca,invisible=c('quali','ind.sup'), habillage = c(11,13), title="Graphe des individus de l'ACP",label =c('ind'))
Le seul pays correspondant à nos critère est Honk Kong. Il semble être le meilleur candidat de ce cluster. Vérifions cela avec les données brutes.
kable(Choix2[order(Choix2$Importation, decreasing = T), c("Importation", "Business score", "PIB US$2015", "Coût import conformité", "Coût import document", "Stabilité politique", "Population", "Distance")]) %>%
kable_paper() %>% column_spec(1, bold = T)
| Importation | Business score | PIB US$2015 | Coût import conformité | Coût import document | Stabilité politique | Population | Distance | |
|---|---|---|---|---|---|---|---|---|
| Hong-Kong | 0.1029651 | 85.31540 | 44189.693 | 265.6250 | 56.8000 | -0.2221780 | 7507400 | 9639.476 |
| Samoa | 0.1014749 | 62.07404 | 4502.926 | 900.0000 | 230.0000 | 1.1577890 | 197093 | 16011.920 |
| Saint-Christophe-et-Niévès | 0.0757088 | 54.63689 | 21516.799 | 310.7143 | 90.0000 | 0.7239246 | 52834 | 6760.687 |
| Saint-Vincent-et-les Grenadines | 0.0723373 | 57.08690 | 7219.892 | 540.0000 | 90.0000 | 0.9535552 | 110593 | 6989.701 |
| Antigua-et-Barbuda | 0.0720795 | 60.28342 | 16786.447 | 546.3889 | 100.0000 | 0.9535552 | 97115 | 6708.770 |
| Emirats arabes unis | 0.0702112 | 80.75261 | 40438.339 | 553.3333 | 283.3333 | 0.6856085 | 9770526 | 5249.535 |
| Bahamas | 0.0641872 | 59.87155 | 32136.762 | 1385.0000 | 550.0000 | 0.8162377 | 389486 | 7209.450 |
| Grenade | 0.0624989 | 53.44488 | 10133.132 | 1256.0000 | 50.0000 | 0.9535552 | 112002 | 7120.287 |
| Dominique | 0.0557041 | 60.54797 | 7914.136 | 905.5556 | 50.0000 | 1.0674570 | 71808 | 6826.396 |
On peut voir que Honk Kong est bien le pays le plus importateur de ce
cluster mais c’est également celui ayant le plus grand business score et
PIB. Sa population est également la deuxième plus grande du cluster.
Honk Kong est donc le meilleur candidat de ce cluster.
Les Emirats
Arabes Unis sont également un bon candidat si nous accordons moins
d’importance à l’importation.